;;;; foreign.test --- FFI.           -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; 	Copyright (C) 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;
;;; See also ../standalone/test-ffi for FFI tests.
;;;

(define-module (test-foreign)
  #:use-module (system foreign)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (test-suite lib))


(with-test-prefix "null pointer"

  (pass-if "zero"
    (= 0 (pointer-address %null-pointer)))

  (pass-if "null pointer identity"
    (eq? %null-pointer (make-pointer 0)))

  (pass-if "null-pointer? %null-pointer"
    (null-pointer? %null-pointer))

  (pass-if-exception "pointer->bytevector %null-pointer"
    exception:null-pointer-error
    (pointer->bytevector %null-pointer 7)))


(with-test-prefix "make-pointer"

  (pass-if "address preserved"
    (= 123 (pointer-address (make-pointer 123)))))


(with-test-prefix "pointer<->bytevector"

  (pass-if "bijection"
    (let ((bv #vu8(0 1 2 3 4 5 6 7)))
      (equal? (pointer->bytevector (bytevector->pointer bv)
                                   (bytevector-length bv))
              bv)))

  (pass-if "pointer from bits"
    (let* ((bytes (iota (sizeof '*)))
           (bv    (u8-list->bytevector bytes)))
      (= (pointer-address
          (make-pointer (bytevector-uint-ref bv 0 (native-endianness)
                                             (sizeof '*))))
         (fold-right (lambda (byte address)
                       (+ byte (* 256 address)))
                     0
                     bytes))))

  (pass-if "dereference-pointer"
    (let* ((bytes (iota (sizeof '*)))
           (bv    (u8-list->bytevector bytes)))
      (= (pointer-address
          (dereference-pointer (bytevector->pointer bv)))
         (fold-right (lambda (byte address)
                       (+ byte (* 256 address)))
                     0
                     bytes)))))


(with-test-prefix "structs"

  (pass-if "parse-c-struct"
    (let ((layout (list int64 uint8))
          (data   (list -300 43)))
      (equal? (parse-c-struct (make-c-struct layout data)
                              layout)
              data))))
